home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / np.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  4.7 KB  |  246 lines
  1. C RDLINE-    READ INPUT LINE
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     SUBROUTINE RDLINE(BUFFER,LENGTH,WHO)
  10.     IMPLICIT INTEGER(A-Z)
  11.     CHARACTER BUFFER(78)
  12. #ifndef PDP
  13.     character*78 sysbuf
  14. #endif
  15. #include "parser.h"
  16. #include "io.h"
  17.  
  18. #ifdef PDP
  19. 5    if (WHO .eq. 1) call prompt
  20. C    read a line of input
  21. 90    call rdlin(BUFFER,LENGTH,WHO)
  22. #else
  23. 5    GO TO (90,10),WHO+1
  24. C                        !SEE WHO TO PROMPT FOR.
  25. 10    WRITE(OUTCH,50)
  26. C                        !PROMPT FOR GAME.
  27. 50    FORMAT(' >',$)
  28.  
  29. 90    READ(INPCH,100) BUFFER
  30. 100    FORMAT(78A1)
  31.  
  32.     DO 200 LENGTH=78,1,-1
  33.       IF(BUFFER(LENGTH).NE.' ') GO TO 250
  34. 200    CONTINUE
  35.     GO TO 5
  36. C                        !TRY AGAIN.
  37.  
  38. C
  39. C    check for shell escape here before things are
  40. C    converted to upper case
  41. C
  42. 250    if (buffer(1) .ne. '!') go to 300
  43.     do 275 j=2,length
  44.       sysbuf(j-1:j-1) = buffer(j)
  45. 275    continue
  46.     sysbuf(j:j) = char(0)
  47.     call system(sysbuf)
  48.     go to 5
  49.  
  50. C CONVERT TO UPPER CASE
  51. 300    DO 400 I=1,LENGTH
  52.        IF(and((BUFFER(I).GE.'a'),(BUFFER(I).LE.'z')))
  53. &        BUFFER(I)=char(ichar(BUFFER(I))-32)
  54. 400    CONTINUE
  55. #endif PDP
  56.  
  57.     if(LENGTH.EQ.0) GO TO 5
  58.     PRSCON=1
  59. C                        !RESTART LEX SCAN.
  60.     RETURN
  61.     END
  62. C PARSE-    TOP LEVEL PARSE ROUTINE
  63. C
  64. C DECLARATIONS
  65. C
  66. C THIS ROUTINE DETAILS ON BIT 0 OF PRSFLG
  67. C
  68.     LOGICAL FUNCTION PARSE(INBUF,INLNT,VBFLAG)
  69.     IMPLICIT INTEGER(A-Z)
  70.     CHARACTER INBUF(78)
  71.     LOGICAL LEX,SYNMCH,VBFLAG
  72.     INTEGER OUTBUF(40)
  73. #include "debug.h"
  74. #include "parser.h"
  75. #include "xsrch.h"
  76. C
  77. #ifdef debug
  78.     DFLAG=and(PRSFLG,1).NE.0
  79. #endif
  80.     PARSE=.FALSE.
  81. C                        !ASSUME FAILS.
  82.     PRSA=0
  83. C                        !ZERO OUTPUTS.
  84.     PRSI=0
  85.     PRSO=0
  86. C
  87. #ifdef PDP
  88. C    LEX recoded in C for pdp version (see lex.c)
  89.     if(.not. lex(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG,PRSCON)) goto 100
  90. #else
  91.     IF(.NOT.LEX(INBUF,INLNT,OUTBUF,OUTLNT,VBFLAG)) GO TO 100
  92. #endif
  93.     IF(SPARSE(OUTBUF,OUTLNT,VBFLAG)) 100,200,300
  94. C                        !DO SYN SCAN.
  95. C
  96. C PARSE REQUIRES VALIDATION
  97. C
  98. 200    IF(.NOT.VBFLAG) GO TO 350
  99. C                        !ECHO MODE, FORCE FAIL.
  100.     IF(.NOT.SYNMCH(X)) GO TO 100
  101. C                        !DO SYN MATCH.
  102.     IF(and((PRSO.GT.0),(PRSO.LT.XMIN))) LASTIT=PRSO
  103. C
  104. C SUCCESSFUL PARSE OR SUCCESSFUL VALIDATION
  105. C
  106. 300    PARSE=.TRUE.
  107. 350    CALL ORPHAN(0,0,0,0,0)
  108. C                        !CLEAR ORPHANS.
  109. #ifdef debug
  110.     if(dflag) write(0,*) "parse good"
  111.     IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI
  112. 10    FORMAT(' PARSE RESULTS- ',L7,3I7)
  113. #endif
  114.     RETURN
  115. C
  116. C PARSE FAILS, DISALLOW CONTINUATION
  117. C
  118. 100    PRSCON=1
  119. #ifdef debug
  120.     if(dflag) write(0,*) "parse failed"
  121.     IF(DFLAG) PRINT 10,PARSE,PRSA,PRSO,PRSI
  122. #endif
  123.     RETURN
  124. C
  125.     END
  126. C ORPHAN- SET UP NEW ORPHANS
  127. C
  128. C DECLARATIONS
  129. C
  130.     SUBROUTINE ORPHAN(O1,O2,O3,O4,O5)
  131.     IMPLICIT INTEGER(A-Z)
  132.     COMMON /ORPHS/ A,B,C,D,E
  133. C
  134.     A=O1
  135. C                        !SET UP NEW ORPHANS.
  136.     B=O2
  137.     C=O3
  138.     D=O4
  139.     E=O5
  140.     RETURN
  141.     END
  142. #ifndef PDP
  143. C LEX-    LEXICAL ANALYZER
  144. C
  145. C
  146. C THIS ROUTINE DETAILS ON BIT 1 OF PRSFLAG
  147. C
  148.     LOGICAL FUNCTION LEX(INBUF,INLNT,OUTBUF,OP,VBFLAG)
  149.     IMPLICIT INTEGER(A-Z)
  150.     CHARACTER INBUF(78),J,DLIMIT(9)
  151.     INTEGER OUTBUF(40)
  152.     LOGICAL VBFLAG
  153. #include "parser.h"
  154. C
  155. #include "debug.h"
  156. C
  157.     DATA DLIMIT/'A','Z',o'100','1','9',o'22','-','-',o'22'/
  158. C
  159.     DO 100 I=1,40
  160. C                        !CLEAR OUTPUT BUF.
  161.       OUTBUF(I)=0
  162. 100    CONTINUE
  163. C
  164. #ifdef debug
  165.     DFLAG=and(PRSFLG,2).NE.0
  166. #endif debug
  167.     LEX=.FALSE.
  168. C                        !ASSUME LEX FAILS.
  169.     OP=-1
  170. C                        !OUTPUT PTR.
  171. 50    OP=OP+2
  172. C                        !ADV OUTPUT PTR.
  173.     CP=0
  174. C                        !CHAR PTR=0.
  175. C
  176. 200    IF(PRSCON.GT.INLNT) GO TO 1000
  177. C                        !END OF INPUT?
  178.     J=INBUF(PRSCON)
  179. C                        !NO, GET CHARACTER,
  180.     PRSCON=PRSCON+1
  181. C                        !ADVANCE PTR.
  182.     IF(J.EQ.'.') GO TO 1000
  183. C                        !END OF COMMAND?
  184.     IF(J.EQ.',') GO TO 1000
  185. C                        !END OF COMMAND?
  186.     IF(J.EQ.' ') GO TO 6000
  187. C                        !SPACE?
  188.     DO 500 I=1,9,3
  189. C                        !SCH FOR CHAR.
  190.       IF(and((J.GE.DLIMIT(I)),(J.LE.DLIMIT(I+1))))
  191. &        GO TO 4000
  192. 500    CONTINUE
  193. C
  194.     IF(VBFLAG) CALL RSPEAK(601)
  195. C                        !GREEK TO ME, FAIL.
  196.     RETURN
  197. C
  198. C END OF INPUT, SEE IF PARTIAL WORD AVAILABLE.
  199. C
  200. 1000    IF(PRSCON.GT.INLNT) PRSCON=1
  201. C                        !FORCE PARSE RESTART.
  202.     IF(and((CP.EQ.0),(OP.EQ.1))) RETURN
  203.     IF(CP.EQ.0) OP=OP-2
  204. C                        !ANY LAST WORD?
  205.     LEX=.TRUE.
  206. #ifdef debug
  207.     IF(DFLAG) PRINT 10,CP,OP,PRSCON,(OUTBUF(I),I=1,OP+1)
  208. 10    FORMAT(' LEX RESULTS- ',3I7/1X,10O7)
  209. #endif debug
  210.     RETURN
  211. C
  212. C LEGITIMATE CHARACTERS: LETTER, DIGIT, OR HYPHEN.
  213. C
  214. 4000    J1=ichar(J)-ichar(DLIMIT(I+2))
  215. #ifdef debug
  216.     IF(DFLAG) PRINT 20,J,J1,CP
  217. 20    FORMAT(' LEX- CHAR= ',3I7)
  218. #endif debug
  219.     IF(CP.GE.6) GO TO 200
  220. C                        !IGNORE IF TOO MANY CHAR.
  221.     K=OP+(CP/3)
  222. C                        !COMPUTE WORD INDEX.
  223.     GO TO (4100,4200,4300),(MOD(CP,3)+1)
  224. C                        !BRANCH ON CHAR.
  225. 4100    J2=J1*780
  226. C                        !CHAR 1... *780
  227.     OUTBUF(K)=OUTBUF(K)+J2+J2
  228. C                        !*1560 (40 ADDED BELOW).
  229. 4200    OUTBUF(K)=OUTBUF(K)+(J1*39)
  230. C                        !*39 (1 ADDED BELOW).
  231. 4300    OUTBUF(K)=OUTBUF(K)+J1
  232. C                        !*1.
  233.     CP=CP+1
  234.     GO TO 200
  235. C                        !GET NEXT CHAR.
  236. C
  237. C SPACE
  238. C
  239. 6000    IF(CP.EQ.0) GO TO 200
  240. C                        !ANY WORD YET?
  241.     GO TO 50
  242. C                        !YES, ADV OP.
  243. C
  244.     END
  245. #endif PDP
  246.